I 94 Reliability

Set fixed values.

Distance of segment is 2.88 Existing Demand is 1.213110^{5} Lanes in segment: 5

Add variables to the existing dataset.

15 minute volume takes the VMT for each time bin and divides by the length of the segment. Unit: Vehicles per mile. Speed is the segment length divided by the travel time ( * 60). Unit: Miles per hour. Hourly_Flow is the 15 minute volume multipled by 4 and divided by the number of lanes. Unit: Vehicles per hour. Density is the Hourly Flow divided by speed. Unit: Vehicles per hour.

We also create a variable that measures the delay type experienced by the segment. Weather (snow) events and crashes were tracked for the time period. If the segment experiences a weather event and a crash, weather will be the controlling delay type.

Rel_2014 <- dat %>% mutate(Vol_15_min  = VMT_total/Dist1,
                           Speed       = Dist1/TT_mean*60,
                           Hourly_Flow = Vol_15_min*4/Lanes,
                           Dens        = Hourly_Flow/Speed,
                           DateTime    = as.POSIXct(TimeStamp,format="%m/%d/%Y %H:%M"),
                           # DateTime    = as.POSIXct(TimeStamp,format="%Y%m%d %H:%M"),
                           YearDay     = weekdays(DateTime),
                           DateTimeSec = as.numeric(DateTime),
                           Delay_type  = (ifelse(weather == 1, 
                                                'Weather',
                                                ifelse(Crash == 1, 
                                                       'Crash',
                                                       'None'))),
                           Index = seq(1,length(Speed),1)) %>%
  filter(!is.na(DateTime))

boxplot(Rel_2014$Dens)

Rel_2014 <- Rel_2014 %>%
  mutate(Rollavg = (rollmean(TT_mean,k=8,fill = TT_mean, align = 'right') +
                      rollmean(TT_mean,k=8,fill = TT_mean, align = 'left'))/2) %>%
  mutate(outlier = ifelse(abs(Rollavg - TT_mean) > 6 * sd(Rollavg), TRUE, FALSE))  
  # filter(Dens <= 100) #3N

# 1N
# bins <- c(seq(floor(min(Rel_2014$Dens)),30,2),
#           40,50,ceiling(max(Rel_2014$Dens)))


bins <- c(seq(floor(min(Rel_2014$Dens)),max(Rel_2014$Dens)+2,2))

# bins <- c(seq(floor(min(Rel_2014$Dens)),24,2),
#           max(Rel_2014$Dens)+1)

Rel_2014$cut <- cut(Rel_2014$Dens,bins,include.lowest = TRUE)
Rel_2014$Density_bin <- as.numeric(stringi::stri_match_last_regex(Rel_2014$cut,'[0-9]+')) 

Rel_2014 %>%
  group_by(Density_bin) %>%
  summarise(Count = n()) %>%
  arrange(Density_bin)

Percentile Bins

We will break down the dataset into each delay type and then further into percentiles.

The percentiles choosen are 0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95.

For each quantile a travel time quantile is calculated. We also want to calculate a Free Floew Speed for each quantile.

The Free Flow speeds were calcuated using the 95th percentile speeds.

ff <- ggplot()+
  geom_point(data = data.frame(Rel_2014_bin_dt),aes(x=Density_bin,y=Flow, color=quantiles))+
  geom_abline(data = data.frame(Rel_2014_FF), aes(slope = FF_quantile, intercept = 0, linetype = 'dashed', color = quantiles))+
  facet_grid(~Delay_type)
ggplotly(ff)

A look at the Density vs travel time plots. A generic smooting function has been added.

tt <- ggplot()+
  geom_point(data=Rel_2014_bin_dt,aes(x= Density_bin,y = TT_quantile, color= quantiles))+
  geom_smooth(data=Rel_2014_bin_dt,aes(x= Density_bin,y = TT_quantile, color= quantiles),se=F)+
  facet_grid(~Delay_type)
ggplotly(tt)

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

We need to find the congestion point for each Delay type and percentile.

Plots

Below are the Flow vs Density plots for each condition.

Verical lines show the congestion Density for each condition.

f <- ggplot()+
  geom_point(data=filter(Rel_2014_bin_dt,Delay_type == 'Weather') ,
             aes(x= Density_bin,y = Flow, color= quantiles))+
  geom_smooth(data=filter(Rel_2014_bin_dt,Delay_type == 'Weather'),
              aes(x= Density_bin,y = Flow, color= quantiles),span =1,se=F)+
  geom_vline(data=filter(model_max,Delay_type == 'Weather'),aes(xintercept=Cong_Density, color = quantiles)) +
  ggtitle('Delay Type = "Weather"')
ggplotly(f)

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

f <- ggplot()+
  geom_point(data=filter(Rel_2014_bin_dt,Delay_type == 'Crash') ,
             aes(x= Density_bin,y = Flow, color= quantiles))+
  geom_smooth(data=filter(Rel_2014_bin_dt,Delay_type == 'Crash'),
              aes(x= Density_bin,y = Flow, color= quantiles),span =0.75,se=F)+
  geom_vline(data=filter(model_max,Delay_type == 'Crash'),aes(xintercept=Cong_Density, color = quantiles)) +
  ggtitle('Delay Type = "Crash"')
ggplotly(f)

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

f <- ggplot()+
  geom_point(data=filter(Rel_2014_bin_dt,Delay_type == 'None') ,
             aes(x= Density_bin,y = Flow, color= quantiles))+
  geom_smooth(data=filter(Rel_2014_bin_dt,Delay_type == 'None'),
              aes(x= Density_bin,y = Flow, color= quantiles),span =1,se=F)+
  geom_vline(data=filter(model_max,Delay_type == 'None'),aes(xintercept=Cong_Density, color = quantiles)) +
  ggtitle('Delay Type = "None"')
ggplotly(f)

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Demand

We now calcualte Demand.

If Density is less than the congestion density, Demand = Flow. If density is greated that the congestion density, Demand = 2 x Congestion Flow - Flow.

TTI is the travel time divided by the travel time at Free Flow.

Rel_2014_bin_dt <- merge(Rel_2014_bin_dt,model_max,by = c('Delay_type','quantiles')) %>%
  mutate(Demand = ifelse(Density_bin <= Cong_Density,Flow,2*Cong_Flow - Flow),
         DC = Demand/Cong_Flow)

s <- ggplot()+
  # geom_point(data=Rel_2014_bin_dt,aes(x= Demand,y = TTI_pred, color= quantiles))+
  geom_smooth(data=Rel_2014_bin_dt,aes(x= Demand,y = TTI, color= quantiles),se=F)+
  geom_point(data=Rel_2014_bin_dt,aes(x= Demand,y = TTI, color= quantiles))+
  # geom_smooth(se=F)+
  # geom_abline(data=Rel_2014_FF,aes(slope = FF,intercept = FF,colour = as.factor(quantiles)))+
  facet_grid(~Delay_type)
ggplotly(s)

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Predict

We join each model back to the original dataset and create a predicted TTI for each row.

pr <- ggplot(Rel_2014_f, aes(x=TTI,y=pred, color=Quantiles))+
  geom_point()+
  facet_grid(~Delay_type)
ggplotly(pr)

Rel_2014_p <- Rel_2014_f %>%
  mutate(F_Dem = Demand * Future,
         DC    = F_Dem/Cong_Flow) %>%
  nest(-Delay_type,-Quantiles) %>%
  merge(model_nls %>% select(Delay_type, Quantiles = quantiles, fit)) %>%
  as.tibble() %>%
  mutate(pred = map2(fit,data,predict)) %>%
  as.tibble() %>%
  unnest(data,pred) %>%
  mutate(TT = pred * (Dist1/FF * 60)) %>%
  select(DateTime, DateTimeSec, TT) 
  # mutate(DateTime = as.character(DateTime))

seq_15min_2015 <- data.frame(DateTime=seq(as.POSIXct("2015,01,01",format="%Y,%m,%d"),
                                          as.POSIXct("2016,01,01",format="%Y,%m,%d"),by="15 min"))
seq_15min_2015 <- seq_15min_2015[-1,] %>% data.frame(DateTime = .)

Rel_2014_p <- merge(seq_15min_2015, Rel_2014_p, all.x = TRUE)

# write.csv(Rel_2014_p,'3_s_predict.csv',row.names = FALSE)